PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/spooldb.com/SPOOL.PAS

Pascal/Delphi Source File | 1989-05-25 | 26.8 KB | 610 lines

{==============================================================================
 Name: Spool.pas

 Description: This unit allows a program to spool text files and print them
              while the program does other process.  It provides several
              functions to add and delete spool request, and to halt the
              spooler.
              The DOS command PRINT must be executed before the program is
              run.  You may elect to place the print command in a batch file
              or leave it up to the user.
              The basic flow of logic is as follows.  You pass the spooler a
              file name to send to the printer.  It ques it and places the
              name on a stack.  While your program processes other tasks the
              file is printed.  Other files can be sent before the first
              file is finished.  When your program exits, the spooler unit
              will check to see if there are any print requests pending.  If
              there is, the spooler unit will ask the user if he wants to
              halt the spooler and exit.  If the halt option is chosen the
              spooler is then halted, and all spool files deleted.  If he
              chooses to wait, the program will sit and wait until all files
              are processed, upon completion the unit will beep three times.
              The user may also choose to exit and continue printing.  If
              this option is chosen, the program will terminate, but the
              print requests will continue to be printed.  The spool files
              will not be deleted, and should be deleted upon starting the
              your program, this is up to the main program.  All print
              requests can be handled by the standard DOS command "PRINT".
              It is up to the main program to supply the names for the spooler.
              You can use any names you wish.  The most conventional would be a
              base with a numeric extension.  If you elect, the spooler can
              generate a spool name.  It will return the next logical name.
              The base will be SPOOL and will contain a three digit numeric
              extension starting with 000.  It is not wise to delete or modify
              the spool files while they are qued.  If you wish you may delete
              them from the spooler using the standard Cancel_Files command.
              Spool files can reside anywhere.
              One last note, the variable SpoolExitProc is a procedure
              variable.  You can set this variable to a procedure you want
              executed before your program terminates, that will give you a
              chance to do something about the spooler before your program
              exits. There is a default routine that is activated if you choose
              not to write your own.  It asks whether you want to halt the
              spooler, wait for the spooler to finish, or exit and leave the
              spooler printing.  To use your own you will need to write a
              procedure, there should be no parameters.  Next, somewhere near
              the beginning of your program place the following statement:

              SpoolExitProc:=YourProcedure;

              Now, upon exiting your program, "YourProcedure" will be called.

              The two procedures you'll use most is Get_Spool_Name and Submit.
              The first will supply a spool name for you and the second will
              submit the last spool name generated.  This gives a quick way
              of using the spooler.  There are other options that give you
              more control.

 Author: David Bradley

 VERSION: 1.1

 This software is donated to the public domain.  All I ask is that you leave
 my name where it is, I need some credit.  I hope you find this software
 usefull.
=============================================================================}

unit Spool;

interface

uses
  Crt,
  Dos;

var
  Spool_Extension_Number:integer;             { Contains the current extension number, for automatic name generation }

{ Hook for main program to replace exit logic of spooler 5.0 specific }
{$IFNDEF VER40}
  SpoolExitProc:procedure;
{$ENDIF }

{ This proceure automatically submits the last spool file name generated by the
  Get_Spool_Name function. }

procedure Submit;


{ Submit a file to the spooler }

function Submit_File(Name:string):boolean;


{ Submit files to the spooler, wild cards allowed }

function Submit_Files(Name:string):boolean;


{ Cancel a spooled file, wild cards allowed }

function Cancel_File(Name:string):boolean;


{ Terminate the spooler - stops printing and cancels all pending jobs }

procedure Terminate_Spooler;


{ Get the next spooler entry, each sucessive call returns the next file name
  , if null (''), you are at the end of the list.  Another call will return
  the first name again.  This function pauses the spooler, you'll need to use
  Resume_Spooler after your have retrieved all the names you want. }

function Get_Spooler_Entry:string;


{ Pause the spooler, stops printing, use Resume_Spooler to continue printing }

procedure Pause_Spooler;


{ Resume the spooler, after it has been paused }

procedure Resume_Spooler;


{ Check to see if spooler (PRINT) has been installed }

function Spooler_Installed:boolean;


{ Get the next spool name - this function allows you to allocate file names
  to reports you want to spool.  The names begin with SPOOL and have a
  numeric extension.  You can pass any name to the spooler system, this is
  just a handy way to keep the names straight.}

function Get_Spool_Name:string;


{ Check to see if the spooler is empty }

function Spooler_Empty:boolean;

{$IFDEF VER40}
procedure SpoolExit;
{$ENDIF }

implementation

type
  Packet_Type=record                          { Layout of Packet data for PRINT }
                Level:byte;                   { Level ??? }
                ASCIIZ:pointer;               { Pointer to file name }
              end;

  Spool_Name_Type=record                      { Structure for spool name stack }
                    SName:string[64];         { Name of spool file }
                    Next:pointer;             { Address of next entry / Nil if last }
                  end;
var
  Spooler_Halted:boolean;                     { Flag to indicate if spooler has been halted }
  Spooler_List:pointer;                       { Pointer to interal list of file qued file names }
  Spool_Name_List:pointer;                    { Pointer to begging of spool file name stack }
  OldExitProc:pointer;                        { Holds old exit pointer }
  Last_Spool_Name:string;                     { Holds last spool name generated }

{=============================================================================}
{                             BEEPS SPEEKER (For internal use)                }
{=============================================================================}
procedure Beep;
begin
  Sound(1000);
  Delay(500);
  NoSound;
end;

{=============================================================================}
{ Add a name to the spool name stack (For internal use )                      }
{=============================================================================}
function Add_Spool_Name(Name:string):boolean;
var
  Spool_Name:^Spool_Name_Type;                      { Pointer to spool info }
  Last_Spool_Name:^Spool_Name_Type;                 { Another pointer }

begin
  if MemAvail<SizeOf(Spool_Name_Type)+4 then        { Check available memory }
  begin
    Add_Spool_Name:=false;                          { No memory, return false }
    exit;                                           { and exit function }
  end;
  New(Spool_Name);                                  { Allocate memory for new spool file name }
  Spool_Name^.Next:=Nil;                            { Clear next pointer of new element }
  Spool_Name^.SName:=Name;                          { Place name of spool file into element }
  if Spool_Name_List=Nil then                       { If spool name list is emtpy }
    Spool_Name_List:=Spool_Name                     { Set the list pointer to point to the new element }
  else                                              { Else if there are elements in the list }
  begin
    Last_Spool_Name:=Spool_Name_List;               { Find the last element in the list }
    while Last_Spool_Name^.Next<>Nil do Last_Spool_Name:=Last_Spool_Name^.Next;
    Last_Spool_Name^.Next:=Spool_Name;              { Point last element to new element }
  end;
  Add_Spool_Name:=true;                             { Everything OK return now }
end;

{=============================================================================}
{ Delete a spool name from the spool name stack                               }
{=============================================================================}
procedure Delete_Spool_Name(Name:string);
var
  Previous:pointer;                                 { Holds address of previous element }
  Next:pointer;                                     { Holds address of next element }
  Spool_Name:^Spool_Name_Type;                      { Pointer to spool list element }

begin
  Spool_Name:=Spool_Name_List;                      { Position to first element in the list }
  Previous:=Nil;                                    { Initialize Previous pointer }
  while Spool_Name<>Nil do                          { While not at the end of the list }
  begin
    if Spool_Name^.SName=Name then                  { If Name is the same as element's name }
    begin
      Next:=Spool_Name^.Next;                       { Set Next pointer to the targetted element's next pointer }
      Dispose(Spool_Name);                          { Free up memory used be targetted element }
      if Previous=Nil then                          { If this is the first element }
        Spool_Name_List:=Next                       { Then set spool name list pointer to next element }
      else                                          { else if this is not the first element }
      begin
        Spool_Name:=Previous;                       { Got back to the previous element looked at }
        Spool_Name^.Next:=Next;                     { Set the next pointer of the previous element to }
      end;                                          { the next pointer saved earlier }
      Exit;                                         { Exit procedure }
    end
    else                                            { Else if this is not the name we want }
    begin
      Previous:=Spool_Name;                         { Set previous pointer to current element }
      Spool_Name:=Spool_Name^.Next;                 { Position to next element }
    end;
  end;                                              { End of while loop, exits if end of list reached }
end;

{=============================================================================}
{ This submits the file name that was last generated by the Get_Spool_Name    }
{ function                                                                    }
{=============================================================================}
procedure Submit;
begin
  if not Spooler_Installed then exit;               { Check to see if PRINT is resident }
  if Submit_File(Last_Spool_Name) then;             { Submit last spool name generated to spooler }
end;

{=============================================================================}
{ Submits a name to the print spooler, no wildcard characters / this routine  }
{ is used mainly by Submit_Files.  This should only be used if you are going  }
{ to submit one file at a time, this will speed up the process.               }
{=============================================================================}
function Submit_File(Name:string):boolean;
var
  Regs:registers;                                   { Register variables for DOS function calls }
  SubmitPacket:Packet_Type;                         { Packet variable for file submissions to spooler }

  { This function checks for the existance of a file }
  function Exist(N:string):boolean;
  var
    F:File;                                         { Dummy file variable }
    OK:boolean;

  begin
    assign(F,N);                                    { Assign file name to file variable }
    reset(F);                                       { Try to open file }
    OK:=IOResult=0;                                 { Check for an I/O error }
    if OK then close(F);                            { Close the file if it was opened }
  end;

begin
  if not Exist(Name) or not Spooler_Installed then  { If file doesn't exist }
  begin
    Submit_File:=false;                             { Return a value of false }
    exit;                                           { Exit this function }
  end;
  with SubmitPacket do
  begin
    Level:=0;                                       { Set level to 0 }
    ASCIIZ:=Addr(Name);                             { Pass address of Name to packet variable }
    Name[length(Name)+1]:=#0;                       { Place a ASCII 0 at end of string }
    inc(longint(ASCIIZ));                           { Increment the string pointer by 1 }
  end;                                              { This passes up the length byte }
  Regs.AX:=$0101;                                   { Submit file function }
  Regs.DS:=Seg(SubmitPacket);                       { Pass segment address of packet variable }
  Regs.DX:=Ofs(SubmitPacket);                       { Pass offset of address of packet variable }
  Intr($2F,Regs);                                   { Call interrupt }
  if (FCarry and Regs.Flags)=0 then                 { If carry wasn't set }
  begin
    Submit_File:=Add_Spool_Name(Name);              { Add file name to list and return result }
    exit;                                           { exit function }
  end
  else                                              { Else if the carry flag is set }
  begin
    Submit_File:=false;                             { Return a value of false }
    exit;                                           { exit function }
  end;
end;

{=============================================================================}
{ Submits a file or files to the print que, standard DOS wildcard characters  }
{ are allowed.                                                                }
{=============================================================================}
function Submit_Files(Name:string):boolean;
var
  SRec:SearchRec;                                   { Search variable for FindNext procedure }
  LastSlash,                                        { Position of last slash in file name }
  Count:integer;                                    { Counter for "for" loop }
  Path:string[64];                                  { Holds path of file }

begin
  if not Spooler_Installed then                     { if PRINT is not resident, exit }
  begin
    Submit_Files:=false;
    exit;
  end;
  LastSlash:=0;                                     { Set LastSlash to 0 }
  Path:='';                                         { Set Path to Null }
  for Count:=1 to length(Name) do                   { Process each character of string Name }
    if Name[Count]='\' then                         { If the character of Name is a backslash }
      LastSlash:=Count;                             { then set LastSlash to current position in string }
  if LastSlash>0 then Path:=copy(Path,1,LastSlash); { Copy the path part of the file name to Path }
  FindFirst(Name,0,SRec);                           { Find the first matching name }
  while DosError=0 do                               { If found }
  begin
    if not Submit_File(Path+SRec.Name) then         { Submit the file to the spooler }
    begin
      Terminate_Spooler;                            { If there was an error, terminate the spooler }
      Submit_Files:=false;                          { Return a value of false }
      exit;                                         { Exit the function }
    end;
    FindNext(SRec);                                 { Get next matching file name }
  end;
  if DosError<>18 then                              { If the DOS Error was anything but file not found }
  begin
    Submit_Files:=false;                            { Return a value of false }
    exit;                                           { and exit function }
  end
  else                                              { Else if file not found }
  begin
    Submit_Files:=true;                             { return a value of true }
    exit;                                           { and exit function }
  end;
end;

{=============================================================================}
{ Cancels a file on the que and deletes the name for the spool name stack     }
{=============================================================================}
function Cancel_File(Name:string):boolean;
var
  Regs:registers;                                   { Register variable for interrupts }

begin
  if not Spooler_Installed then                     { if PRINT is not resident, exit }
  begin
    Cancel_File:=false;
    exit;
  end;
  Regs.AX:=$0102;                                   { Load cancel function call number }
  Regs.DS:=Seg(Name);                               { Load segment of address of file name variable }
  Regs.DX:=Ofs(Name);                               { Load offset of address of file name variable }
  Intr($2F,Regs);                                   { Call multiplex interrupt }
  if (FCarry and Regs.Flags)=0 then                 { If carry flag wasn't set (OK)}
    Delete_Spool_Name(Name);                        { Delete name from list of spool names }
  Cancel_File:=(FCarry and Regs.Flags)=0;           { Return a value of true if carry flag not set }
end;

{=============================================================================}
{ This terminates the spooler, all spool files are left intact.               }
{=============================================================================}
procedure Terminate_Spooler;
var
  Regs:registers;                                   { Register variable for interrupt }

begin
  if not Spooler_Installed then exit;               { if PRINT is not resident, exit }
  Regs.AX:=$0103;                                   { Load terminate function call number }
  Intr($2F,Regs);                                   { Call multiplex interrupt }
end;

{=============================================================================}
{ Gets the next spooler name, if blank there are no entries.  Also it pauses  }
{ the spooler.  As soon as you have gotten all the names you need, use        }
{ Resume_Spooler to continue printing.                                        }
{=============================================================================}
function Get_Spooler_Entry:string;
type
  Entry=array[1..64] of byte;                       { variable type declaration for spool name entry }

var
  Regs:registers;                                   { Register variable }
  Hold:^Entry;                                      { Variable to point to spool name entry }
  S:string;                                         { String variable }
  Position:integer;                                 { Holds position of end of string }

begin
  if not Spooler_Installed then                     { if PRINT is not resident, exit }
  begin
    Get_Spooler_Entry:='';
    exit;
  end;
  if not Spooler_Halted then                        { if spooler is not halted }
  begin
    Regs.AX:=$0104;                                 { then halt the spooler }
    Intr($2F,Regs);
    Spooler_List:=Ptr(Regs.DS,Regs.SI);             { Set spooler list to start of list }
    Spooler_Halted:=true;
  end;
  Hold:=Spooler_List;                               { Point hold to list of spool entries }
  if Hold^[1]=0 then                                { If entry is null }
  begin
    Resume_Spooler;                                 { Resume the spooler }
    Get_Spooler_Entry:='';                          { and return null }
    exit;
  end;
  Position:=1;                                      { Set position variable }
  while (Hold^[Position]<>32) and (Hold^[Position]<>0) do  { Repeat until space or null character }
  begin
    S[Position]:=char(Hold^[Position]);             { Move character to string }
    inc(Position);                                  { Next character }
  end;
  S[0]:=chr(Position-1);                            { Set length of string }
  inc(longint(Spooler_List),64);                    { Move spooler list variable to next entry }
  Get_Spooler_Entry:=S;                             { Return name }
end;

{=============================================================================}
{ Temporarily pauses the spooler.  Use Resume_Spooler to continue.            }
{=============================================================================}
procedure Pause_Spooler;
var
  Regs:registers;

begin
  if not Spooler_Installed then exit;               { if PRINT is not resident, exit }
  Regs.AX:=$0104;
  Intr($2F,Regs);
  Spooler_List:=Ptr(Regs.DS,Regs.SI);
  Spooler_Halted:=true;
end;

{=============================================================================}
{ Resumes spooling due to a Pause_Spooler or a Get_Spool_Entry.               }
{=============================================================================}
procedure Resume_Spooler;
var
  Regs:registers;

begin
  if not Spooler_Installed then exit;               { if PRINT is not resident, exit }
  Regs.AX:=$0105;
  Intr($2F,Regs);
  Spooler_List:=Nil;
  Spooler_Halted:=false;
end;

{=============================================================================}
{ Tells you if a spooler is installed.                                        }
{=============================================================================}
function Spooler_Installed:boolean;
var
  Regs:registers;

begin
  Regs.AX:=$0100;
  Intr($2F,Regs);
  Spooler_Installed:=Regs.Al=$FF;
end;

{=============================================================================}
{ Erases a file, internal procedure only                                      }
{=============================================================================}
procedure EraseF(Name:string);
var
  F:File;

begin
  assign(F,Name);
  erase(F);
end;

{=============================================================================}
{ Exit logic to check for spooling activity before a program ends.  This is a }
{ simplist routine to afford the user some options before the program ends.   }
{ The programmer may elect to check for spooler activity via the main program }
{ and afford a more gracefull exit logic.  You can check for spooler activity }
{ by using the Get_Spool_Entry, if a name is returned then the spooler is     }
{ still printing.  Remember to use resume if you wish to continue spooling    }
{=============================================================================}
{$F+}
procedure SpoolExit;
var
  Name:string;
  Spool_Name:^Spool_Name_Type;
  Answer:char;
  Count:integer;
  NextName:pointer;

begin
  ExitProc:=OldExitProc;
  if Spooler_Installed then
  begin
    Name:=Get_Spooler_Entry;
    Resume_Spooler;
    if Name<>'' then
    begin
      TextColor(7);
      TextBackground(0);
      ClrScr;
      writeln('Spooler is active, select on of the following:'+chr(13));
      writeln('(H)alt spooler,');
      writeln('(W)ait until finished,');
      writeln('(E)xit and leave spooler files to be processed');
      repeat
        read(Answer);
        Answer:=UpCase(Answer);
      until Answer in ['E','H','W'];
      if Answer='E' then exit;
      if Answer='W' then
      begin
        repeat
          ClrScr;
          gotoxy(20,12);
          write('Waiting for spooler to complete printing');
          Name:=Get_Spooler_Entry;
          Resume_Spooler;
          for Count:=1 to 30000 do;
        until Name='';
        Beep;
        Beep;
        Beep;
      end;
      if Answer='H' then
        Terminate_Spooler;
    end;
  end;
  Spool_Name:=Spool_Name_List;
  while Spool_Name<>Nil do
  begin
    EraseF(Spool_Name^.SName);
    Spool_Name:=Spool_Name^.Next;
  end;
  Spool_Name:=Spool_Name_List;
  while Spool_Name<>Nil do
  begin
    NextName:=Spool_Name^.Next;
    Dispose(Spool_Name);
    Spool_Name:=NextName;
  end;
end;
{$F-}

{=============================================================================}
{ Returns then next logical spool name (SPOOL.000, SPOOL.001, SPOOL.002...)   }
{=============================================================================}
function Get_Spool_Name:string;
var
  Extension:string[4];
  Count:integer;

begin
  if not Spooler_Installed then                     { if PRINT is not resident, exit }
  begin
    Get_Spool_Name:='';
    exit;
  end;
  str(Spool_Extension_Number:3,Extension);          { Convert spool number to string }
  for Count:=1 to length(Extension) do              { Change blanks in extension to zeros }
    if Extension[Count]=' ' then Extension[Count]:='0';
  inc(Spool_Extension_Number);                      { Increment extension number }
  Spool_Extension_Number:=Spool_Extension_Number mod 1000;  { Extension must be between 0 and 1000 }
  Last_Spool_Name:='SPOOL.'+Extension;              { Build spool name with extension }
  Get_Spool_Name:=Last_Spool_Name;                  { return name }
end;

{=============================================================================}
{ This tests to see if the spooler is empty                                   }
{=============================================================================}
function Spooler_Empty:boolean;
var
  Name:string;

begin
  if not Spooler_Installed then                     { if PRINT is not resident, exit }
  begin
    Spooler_Empty:=true;
    exit;
  end;
  Name:=Get_Spooler_Entry;
  Resume_Spooler;
  Spooler_Empty:=Name='';
end;

{=============================================================================}
{ Initialization logic for Spool unit.                                        }
{=============================================================================}
begin
  { The next three lines will need to be modified for version 4.0 }
{$IFNDEF VER40}
  SpoolExitProc:=SpoolExit;                         { Set default exit procedure, 5.0 specific }
  OldExitProc:=ExitProc;                            { Save old exit procedure address }
  ExitProc:=@SpoolExitProc;                         { Set new exit procedure to SpoolExitProc }
{$ENDIF }
  Spooler_Halted:=false;                            { Initialize variables }
  Spooler_List:=Nil;
  Spool_Name_List:=Nil;
  Spool_Extension_Number:=0;
end.